home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_ghostscript.idb / usr / freeware / lib / ghostscript / 3.33 / bdftops.ps.z / bdftops.ps
Encoding:
Text File  |  1998-05-21  |  22.5 KB  |  788 lines
  1. %    Copyright (C) 1990, 1995 Aladdin Enterprises.  All rights reserved.
  2. % 
  3. % This file is part of GNU Ghostscript.
  4. % 
  5. % GNU Ghostscript is distributed in the hope that it will be useful, but
  6. % WITHOUT ANY WARRANTY.  No author or distributor accepts responsibility to
  7. % anyone for the consequences of using it or for whether it serves any
  8. % particular purpose or works at all, unless he says so in writing.  Refer
  9. % to the GNU Ghostscript General Public License for full details.
  10. % 
  11.  
  12. % bdftops.ps
  13. % Convert a BDF file (possibly with (an) associated AFM file(s))
  14. % to a PostScript Type 1 font (without eexec encryption).
  15. % The resulting font will work with any PostScript language interpreter,
  16. % but not with ATM or other font rasterizers lacking a complete interpreter.
  17.  
  18. /envBDF 120 dict def
  19. envBDF begin
  20.  
  21. % "Import" the image-to-path package.
  22. % This also brings in the Type 1 opcodes (type1ops.ps).
  23.    (impath.ps) run
  24.  
  25. % "Import" the font-writing package.
  26.    (wrfont.ps) run
  27.    wrfont_dict begin
  28.      /binary_CharStrings false def
  29.      /binary_tokens false def
  30.      /encrypt_CharStrings true def
  31.      /standard_only true def
  32.    end
  33.    /lenIV 0 def
  34.  
  35. % Invert the StandardEncoding vector.
  36.    256 dict dup begin
  37.    0 1 255 { dup StandardEncoding exch get exch def } for
  38.    end /StandardDecoding exch def
  39.  
  40. % Define the properties copied to FontInfo.
  41.    mark
  42.      (COPYRIGHT) /Notice
  43.      (FAMILY_NAME) /FamilyName
  44.      (FULL_NAME) /FullName
  45.      (WEIGHT_NAME) /Weight
  46.    .dicttomark /properties exch def
  47.  
  48. % Define the character sequences for synthesizing missing composite
  49. % characters in the standard encoding.
  50.    mark
  51.      /AE [/A /E]
  52.      /OE [/O /E]
  53.      /ae [/a /e]
  54.      /ellipsis [/period /period /period]
  55.      /emdash [/hyphen /hyphen /hyphen]
  56.      /endash [/hyphen /hyphen]
  57.      /fi [/f /i]
  58.      /fl [/f /l]
  59.      /germandbls [/s /s]
  60.      /guillemotleft [/less /less]
  61.      /guillemotright [/greater /greater]
  62.      /oe [/o /e]
  63.      /quotedblbase [/comma /comma]
  64.    .dicttomark /composites exch def
  65.  
  66. % Define the procedure for synthesizing composites.
  67. % This must not be bound.
  68.    /compose
  69.     { exch pop
  70.       FontMatrix Private /composematrix get invertmatrix concat
  71.       0 0 moveto
  72.       dup gsave false charpath pathbbox currentpoint grestore
  73.       6 2 roll setcachedevice show
  74.     } def
  75. % Define the CharString procedure that calls compose, with the string
  76. % on the stack.  This too must remain unbound.
  77.    /compose_proc
  78.     { Private /compose get exec
  79.     } def
  80.  
  81. % Define aliases for missing characters similarly.
  82.    mark
  83.      /acute /quoteright
  84.      /bullet /asterisk
  85.      /cedilla /comma
  86.      /circumflex /asciicircum
  87.      /dieresis /quotedbl
  88.      /dotlessi /i
  89.      /exclamdown /exclam
  90.      /florin /f
  91.      /fraction /slash
  92.      /grave /quoteleft
  93.      /guilsinglleft /less
  94.      /guilsinglright /greater
  95.      /hungarumlaut /quotedbl
  96.      /periodcentered /asterisk
  97.      /questiondown /question
  98.      /quotedblleft /quotedbl
  99.      /quotedblright /quotedbl
  100.      /quotesinglbase /comma
  101.      /quotesingle /quoteright
  102.      /tilde /asciitilde
  103.    .dicttomark /aliases exch def
  104.  
  105. % Define overstruck characters that can be synthesized with seac.
  106.    mark
  107.     [ /Aacute /Acircumflex /Adieresis /Agrave /Aring /Atilde
  108.       /Ccedilla
  109.       /Eacute /Ecircumflex /Edieresis /Egrave
  110.       /Iacute /Icircumflex /Idieresis /Igrave
  111.       /Lslash
  112.       /Ntilde
  113.       /Oacute /Ocircumflex /Odieresis /Ograve /Otilde
  114.       /Scaron
  115.       /Uacute /Ucircumflex /Udieresis /Ugrave
  116.       /Yacute /Ydieresis
  117.       /Zcaron
  118.       /aacute /acircumflex /adieresis /agrave /aring /atilde
  119.       /ccedilla
  120.       /eacute /ecircumflex /edieresis /egrave
  121.       /iacute /icircumflex /idieresis /igrave
  122.       /lslash
  123.       /ntilde
  124.       /oacute /ocircumflex /odieresis /ograve /otilde
  125.       /scaron
  126.       /uacute /ucircumflex /udieresis /ugrave
  127.       /yacute /ydieresis
  128.       /zcaron
  129.     ]
  130.     { dup =string cvs
  131.       [ exch dup 0 1 getinterval cvn
  132.     exch dup length 1 sub 1 exch getinterval cvn
  133.       ]
  134.     } forall
  135.      /cent [/c /slash]
  136.      /daggerdbl [/bar /equal]
  137.      /divide [/colon /hyphen]
  138.      /sterling [/L /hyphen]
  139.      /yen [/Y /equal]
  140.    .dicttomark /accentedchars exch def
  141.  
  142. % ------ Output utilities ------ %
  143.  
  144.    /ws {psfile exch writestring} bind def
  145.    /wl {ws (\n) ws} bind def
  146.    /wt {=string cvs ws ( ) ws} bind def
  147.  
  148. % ------ BDF file parsing utilities ------ %
  149.  
  150. % Define a buffer for reading the BDF file.
  151.    /buffer 400 string def
  152.  
  153. % Read a line from the BDF file into the buffer.
  154. % Ignore empty (zero-length) lines.
  155. % Define /keyword as the first word on the line.
  156. % Define /args as the remainder of the line.
  157. % If the keyword is equal to commentword, skip the line.
  158. % (If commentword is equal to a space, never skip.)
  159.    /nextline
  160.     {  { bdfile buffer readline not
  161.       { (Premature EOF\n) print stop } if
  162.      dup length 0 ne { exit } if pop     
  163.        }
  164.       loop
  165.       ( ) search
  166.        { /keyword exch def pop }
  167.        { /keyword exch def () }
  168.       ifelse
  169.       /args exch def
  170.       keyword commentword eq { nextline } if
  171.     } bind def
  172.  
  173. % Get a word argument from args.  We do *not* copy the string.
  174.    /warg        % warg -> string
  175.     { args ( ) search
  176.        { exch pop exch }
  177.        { () }
  178.       ifelse  /args exch def
  179.     } bind def
  180.  
  181. % Get an integer argument from args.
  182.    /iarg        % iarg -> int
  183.     { warg cvi
  184.     } bind def
  185.  
  186. % Get a numeric argument from args.
  187.    /narg        % narg -> int|real
  188.     { warg cvr
  189.       dup dup cvi eq { cvi } if
  190.     } bind def
  191.  
  192. % Convert the remainder of args into a string.
  193.    /remarg        % remarg -> string
  194.     { args copystring
  195.     } bind def
  196.  
  197. % Get a string argument that occupies the remainder of args.
  198.    /sarg        % sarg -> string
  199.     { args (") anchorsearch
  200.        { pop /args exch def } { pop } ifelse
  201.       args args length 1 sub get (") 0 get eq
  202.        { args 0 args length 1 sub getinterval /args exch def } if
  203.       args copystring
  204.     } bind def
  205.  
  206. % Check that the keyword is the expected one.
  207.    /checkline        % (EXPECTED-KEYWORD) checkline ->
  208.     { dup keyword ne
  209.        { (Expected ) print =
  210.          (Line=) print keyword print ( ) print args print (\n) print stop
  211.        } if
  212.       pop
  213.     } bind def
  214.  
  215. % Read a line and check its keyword.
  216.    /getline        % (EXPECTED-KEYWORD) getline ->
  217.     { nextline checkline
  218.     } bind def
  219.  
  220. % Find the first/last non-zero bit of a non-zero byte.
  221.    /fnzb
  222.     { 0 { exch dup 128 ge { pop exit } { dup add exch 1 add } ifelse }
  223.       loop
  224.     } bind def
  225.    /lnzb
  226.     { 7 { exch dup 1 and 0 ne { pop exit } { -1 bitshift exch 1 sub } ifelse }
  227.       loop
  228.     } bind def
  229.  
  230. % ------ Type 1 encoding utilities ------ %
  231.  
  232. % Parse the side bearing and width information that begins a CharString.
  233. % Arguments: charstring.  Result: sbx sby wx wy substring.
  234.    /parsesbw
  235.     { mark exch lenIV
  236.        {        % stack: mark ... string dropcount
  237.          dup 2 index length exch sub getinterval
  238.      dup 0 get dup 32 lt { pop exit } if
  239.      dup 246 le
  240.       { 139 sub exch 1 }
  241.       { dup 250 le
  242.          { 247 sub 8 bitshift 108 add 1 index 1 get add exch 2 }
  243.          { dup 254 le
  244.         { 251 sub 8 bitshift 108 add 1 index 1 get add neg exch 2 }
  245.         { pop dup 1 get 128 xor 128 sub
  246.           8 bitshift 1 index 2 get add
  247.           8 bitshift 1 index 3 get add
  248.           8 bitshift 1 index 4 get add exch 5
  249.         } ifelse
  250.          } ifelse
  251.       } ifelse
  252.        } loop
  253.       counttomark 3 eq { 0 3 1 roll 0 exch } if
  254.       6 -1 roll pop
  255.     } bind def 
  256.  
  257. % Find the side bearing and width information that begins a CharString.
  258. % Arguments: charstring.  Result: charstring sizethroughsbw.
  259.    /findsbw
  260.     { dup parsesbw 4 { exch pop } repeat skipsbw
  261.     } bind def
  262.    /skipsbw        % charstring sbwprefix -> sizethroughsbw
  263.     { length 1 index length exch sub
  264.       2 copy get 12 eq { 2 } { 1 } ifelse add
  265.     } bind def
  266.  
  267. % Encode a number, and append it to a string.
  268. % Arguments: str num.  Result: newstr.
  269.    /concatnum
  270.     { dup dup -107 ge exch 107 le and
  271.        { 139 add 1 string dup 0 3 index put }
  272.        { dup dup -1131 ge exch 1131 le and
  273.           { dup 0 ge { 16#f694 } { neg 16#fa94 } ifelse add
  274.         2 string dup 0 3 index -8 bitshift put
  275.         dup 1 3 index 255 and put
  276.       }
  277.       { 5 string dup 0 255 put exch
  278.         2 copy 1 exch -24 bitshift 255 and put
  279.         2 copy 2 exch -16 bitshift 255 and put
  280.         2 copy 3 exch -8 bitshift 255 and put
  281.         2 copy 4 exch 255 and put
  282.         exch
  283.       }
  284.      ifelse
  285.        }
  286.       ifelse exch pop concatstrings
  287.     } bind def
  288.  
  289. % ------ Point arithmetic utilities ------ %
  290.  
  291.    /ptadd { exch 4 -1 roll add 3 1 roll add } bind def
  292.    /ptexch { 4 2 roll } bind def
  293.    /ptneg { neg exch neg exch } bind def
  294.    /ptpop { pop pop } bind def
  295.    /ptsub { ptneg ptadd } bind def
  296.  
  297. % ------ The main program ------ %
  298.  
  299.    /readBDF        % <infilename> <outfilename> <fontname>
  300.             %   <encodingname> <uniqueID> <xuid> readBDF -> <font>
  301.     { /xuid exch def        % may be null
  302.       /uniqueID exch def    % may be -1
  303.       /encodingname exch def
  304.     /encoding encodingname cvx exec def
  305.       /fontname exch def
  306.       /psname exch def
  307.       /bdfname exch def
  308.       gsave        % so we can set the CTM to the font matrix
  309.  
  310. %  Open the input files.  We don't open the output file until
  311. %  we've done a minimal validity check on the input.
  312.       bdfname (r) file /bdfile exch def
  313.       /commentword ( ) def
  314.  
  315. %  Check for the STARTFONT.
  316.       (STARTFONT) getline
  317.       args (2.1) ne { (Not version 2.1\n) print stop } if
  318.  
  319. %  Initialize the font.
  320.       /Font 20 dict def
  321.       Font begin
  322.       /FontName fontname def
  323.       /PaintType 0 def
  324.       /FontType 1 def
  325.       uniqueID 0 gt { /UniqueID uniqueID def } if
  326.       xuid null ne { /XUID xuid def } if
  327.       /Encoding encoding def
  328.       /FontInfo 20 dict def
  329.       /Private 20 dict def
  330.       currentdict end currentdict end
  331.       exch begin begin        % insert font above environment
  332.  
  333. %  Initialize the Private dictionary in the font.
  334.       Private begin
  335.       /-! {string currentfile exch readhexstring pop} readonly def
  336.       /-| {string currentfile exch readstring pop} readonly def
  337.       /|- {readonly def} readonly def
  338.       /| {readonly put} readonly def
  339.       /BlueValues [] def
  340.       /lenIV lenIV def
  341.       /MinFeature {16 16} def
  342.       /password 5839 def
  343.       /UniqueID uniqueID def
  344.       end        % Private
  345.  
  346. %  Invert the Encoding, for synthesizing composite characters.
  347.       /decoding encoding length dict def
  348.       0 1 encoding length 1 sub
  349.        { dup encoding exch get exch decoding 3 1 roll put }
  350.       for
  351.  
  352. %  Now open the output file.
  353.       psname (w) file /psfile exch def
  354.  
  355. %  Put out a header compatible with the Adobe "standard".
  356.       (%!FontType1-1.0: ) ws fontname wt (000.000) wl
  357.       (% This is a font description converted from ) ws
  358.     bdfname wl
  359.       (%   by bdftops running on ) ws
  360.       statusdict /product get ws ( revision ) ws
  361.       revision =string cvs ws (.) wl
  362.  
  363. %  Copy the initial comments, up to FONT.
  364.       true
  365.        { nextline
  366.      keyword (COMMENT) ne {exit} if
  367.       { (% Here are the initial comments from the BDF file:\n%) wl
  368.       } if false
  369.      (%) ws remarg wl
  370.        } loop pop
  371.       () wl
  372.       /commentword (COMMENT) def    % do skip comments from now on
  373.  
  374. %  Read and process the FONT, SIZE, and FONTBOUNDINGBOX.
  375.       % If we cared about FONT, we'd use it here.  If the BDF files
  376.       % from MIT had PostScript names rather than X names, we would
  377.       % care; but what's there is unusable, so we discard FONT.
  378.       % The FONTBOUNDINGBOX may not be reliable, so we discard it too.
  379.       (FONT) checkline
  380.       (SIZE) getline
  381.     /pointsize iarg def   /xres iarg def   /yres iarg def
  382.       (FONTBOUNDINGBOX) getline
  383.       nextline
  384.  
  385. %  Initialize the font bounding box bookeeping.
  386.       /fbbxo 1000 def
  387.       /fbbyo 1000 def
  388.       /fbbxe -1000 def
  389.       /fbbye -1000 def
  390.  
  391. %  Read and process the properties.  We only care about a few of them.
  392.       keyword (STARTPROPERTIES) eq
  393.        { iarg
  394.           { nextline
  395.         properties keyword known
  396.          { FontInfo properties keyword get sarg readonly put
  397.          } if
  398.       } repeat
  399.          (ENDPROPERTIES) getline
  400.      nextline
  401.        } if
  402.  
  403. %  Compute and set the FontMatrix.
  404.       Font /FontMatrix
  405.        [ 0.001 0 0 0.001 xres mul yres div 0 0 ] readonly
  406.       dup setmatrix put
  407.  
  408. %  Read and process the header for the bitmaps.
  409.       (CHARS) checkline
  410.     /ccount iarg def
  411.  
  412. %  Initialize the CharStrings dictionary.
  413.       /charstrings ccount
  414.     composites length add
  415.     aliases length add
  416.     accentedchars length add
  417.     1 add dict def        % 1 add for .notdef
  418.       /isfixedwidth true def
  419.       /fixedwidth null def
  420.       /subrcount 0 def
  421.       /subrs [] def
  422.  
  423. %  Read the bitmap data.  This reads the remainder of the file.
  424. %  We do this before processing the bitmaps so that we can compute
  425. %  the correct FontBBox first.
  426.       /chardata ccount dict def
  427.       ccount -1 1
  428.        { (STARTCHAR) getline
  429.            /charname remarg def
  430.      (ENCODING) getline
  431.        /eindex iarg def
  432.        eindex 0 ge
  433.         { charname /charname StandardEncoding eindex get def
  434.           charname /.notdef eq eindex 0 gt and
  435.            { /charname (A) eindex =string cvs concatstrings cvn def
  436.            }
  437.           if
  438.           (/) print charname =string cvs print (,) print print
  439.         }
  440.         { (/) print charname print
  441.         }
  442.        ifelse
  443.        10 mod 1 eq { (\n) print flush } if
  444.      (SWIDTH) getline
  445.        /swx iarg pointsize mul 1000 div xres mul 72 div def
  446.        /swy iarg pointsize mul 1000 div xres mul 72 div def
  447.      (DWIDTH) getline        % Ignore, use SWIDTH instead
  448.      (BBX) getline
  449.        /bbw iarg def  /bbh iarg def  /bbox iarg def  /bboy iarg def
  450.      nextline
  451.      keyword (ATTRIBUTES) eq
  452.       { nextline
  453.       } if
  454.      (BITMAP) checkline
  455.  
  456. % Update the font bounding box.
  457.      /fbbxo fbbxo bbox min def
  458.      /fbbyo fbbyo bboy min def
  459.      /fbbxe fbbxe bbox bbw add max def
  460.      /fbbye fbbye bboy bbh add max def
  461.  
  462. % Read the bits for this character.
  463.      /raster bbw 7 add 8 idiv def
  464.      /cbits raster bbh mul string def
  465.      0 raster cbits length raster sub
  466.       { cbits exch raster getinterval
  467.         bdfile buffer readline not
  468.          { (EOF in bitmap\n) print stop } if
  469.         % stack has <cbits.interval> <buffer.interval>
  470.         0 () /SubFileDecode filter
  471.         exch 2 copy readhexstring pop pop pop closefile
  472.       } for
  473.      (ENDCHAR) getline
  474.  
  475. % Save the character data.
  476.      chardata charname [swx swy bbw bbh bbox bboy cbits] put
  477.        } for
  478.  
  479.       (ENDFONT) getline
  480.  
  481. % Allocate the buffers for the bitmap and the outline,
  482. % according to the font bounding box.
  483.       /fbbw fbbxe fbbxo sub def
  484.       /fbbh fbbye fbbyo sub def
  485.       /fraster fbbw 7 add 8 idiv def
  486.       /bits fraster fbbh mul 200 max 65535 min string def
  487.       /outline bits length 6 mul 65535 min string def
  488.  
  489. %  Process the characters.
  490.       chardata
  491.        { exch /charname exch def  aload pop
  492.      /cbits exch def
  493.      /bboy exch def   /bbox exch def
  494.      /bbh exch def   /bbw exch def
  495.      /swy exch def   /swx exch def
  496.  
  497. % The bitmap handed to type1imagepath must have the correct height,
  498. % because type1imagepath uses this to compute the scale factor,
  499. % so we have to clear the unused parts of it.
  500.      /raster bbw 7 add 8 idiv def
  501.      bits dup 0 1 raster fbbh mul 1 sub
  502.       { 0 put dup } for
  503.      pop pop
  504.      bits raster fbbh bbh sub mul cbits putinterval
  505.  
  506. %  Compute the font entry, converting the bitmap to an outline.
  507.      bits 0 raster fbbh mul getinterval    % the bitmap image
  508.      bbw   fbbh                % bitmap width & height
  509.      swx   swy                % width x & y
  510.      bbox neg   bboy neg            % origin x & y
  511.          % Account for lenIV when converting the outline.
  512.      outline  lenIV  outline length lenIV sub  getinterval
  513.      type1imagepath
  514.      length lenIV add
  515.      outline exch 0 exch getinterval
  516.  
  517. % Check for a fixed width font.
  518.      isfixedwidth
  519.       { fixedwidth null eq
  520.          { /fixedwidth swx def }
  521.          { fixedwidth swx ne { /isfixedwidth false def } if }
  522.         ifelse
  523.       } if
  524.  
  525. % Finish up the character.
  526.      copystring
  527.      charname exch charstrings 3 1 roll put
  528.        } forall
  529.  
  530. %  Add CharStrings entries for aliases.
  531.       aliases
  532.        { charstrings 2 index known not charstrings 2 index known and
  533.           { charstrings exch get charstrings 3 1 roll put
  534.       }
  535.       { pop pop
  536.       }
  537.      ifelse
  538.        }
  539.       forall
  540.  
  541. %  If this is not a fixed-width font, synthesize missing characters
  542. %  out of available ones.
  543.       isfixedwidth not
  544.        { false composites
  545.       { 1 index charstrings exch known not
  546.         1 index { decoding exch known and } forall
  547.          { ( /) print 1 index bits cvs print
  548.            /combine exch def
  549.            0 1 combine length 1 sub
  550.         { dup combine exch get decoding exch get
  551.           bits 3 1 roll put
  552.         } for
  553.            bits 0 combine length getinterval copystring
  554.            [ exch /compose_proc load aload pop ] cvx
  555.            charstrings 3 1 roll put
  556.            pop true
  557.          }
  558.          { pop pop }
  559.         ifelse
  560.       }
  561.      forall flush
  562.       { Private /composematrix matrix put
  563.         Private /compose /compose load put
  564.       }
  565.      if
  566.        }
  567.       if
  568.  
  569. %  Synthesize accented characters with seac if needed and possible.
  570.       accentedchars
  571.        { aload pop /accent exch def /base exch def
  572.          buffer cvs /accented exch def
  573.      charstrings accented known not
  574.      charstrings base known and
  575.      charstrings accent known and
  576.      StandardDecoding base known and
  577.      StandardDecoding accent known and
  578.      encoding StandardDecoding base get get base eq and
  579.      encoding StandardDecoding accent get get accent eq and
  580.       { ( /) print accented print
  581.         charstrings base get findsbw 0 exch getinterval
  582.         /acstring exch def        % start with sbw of base
  583.         charstrings accent get parsesbw
  584.         4 { pop } repeat        % just leave sbx
  585.         acstring exch concatnum
  586.         0 concatnum 0 concatnum        % adx ady
  587.         decoding base get concatnum        % bchar
  588.         decoding accent get concatnum    % achar
  589.         s_seac concatstrings
  590.         charstrings exch accented copystring exch put
  591.       } if
  592.        } forall
  593.  
  594. %  Make a CharStrings entry for .notdef.
  595.       outline lenIV <8b8b0d0e> putinterval    % 0 0 hsbw endchar
  596.       charstrings /.notdef outline 0 lenIV 4 add getinterval copystring put
  597.  
  598. %  Encrypt the CharStrings and Subrs (in place).
  599.       charstrings
  600.        {    % Be careful not to encrypt aliased characters twice,
  601.         % since they share their CharString.
  602.      aliases 2 index known
  603.       { charstrings aliases 3 index get .knownget
  604.          { 1 index ne }
  605.          { true }
  606.         ifelse
  607.       }
  608.       { true
  609.       }
  610.      ifelse
  611.      1 index type /stringtype eq and
  612.           { 4330 exch dup .type1encrypt exch pop
  613.         readonly charstrings 3 1 roll put
  614.       }
  615.       { pop pop
  616.       }
  617.      ifelse
  618.        }
  619.       forall
  620.       0 1 subrcount 1 sub
  621.        { dup subrs exch get
  622.      4330 exch dup .type1encrypt exch pop
  623.      subrs 3 1 roll put
  624.        }
  625.       for
  626.  
  627. %  Make most of the remaining entries in the font dictionaries.
  628.  
  629. % The Type 1 font machinery really only works with a 1000 unit
  630. % character coordinate system.  Set this up here, by computing the factor
  631. % to make the X entry in the FontMatrix come out at exactly 0.001.
  632.       /fontscale 1000 fbbh div yres mul xres div def
  633.       Font /FontBBox
  634.        [ fbbxo fontscale mul
  635.      fbbyo fontscale mul
  636.      fbbxe fontscale mul
  637.      fbbye fontscale mul
  638.        ] cvx readonly put
  639.       Font /CharStrings charstrings readonly put
  640.       FontInfo /FullName known not
  641.        { % Some programs insist on FullName being present.
  642.          FontInfo /FullName FontName dup length string cvs put
  643.        }
  644.       if
  645.       FontInfo /isFixedPitch isfixedwidth put
  646.       subrcount 0 gt
  647.        { Private /Subrs subrs 0 subrcount getinterval readonly put
  648.        } if
  649.  
  650. %  Determine the italic angle and underline position
  651. %  by actually installing the font.
  652.       save
  653.       /_temp_ Font definefont setfont
  654.       [1000 0 0 1000 0 0] setmatrix        % mitigate rounding problems
  655. % The italic angle is the multiple of -5 degrees
  656. % that minimizes the width of the 'I'.
  657.       0 9999 0 5 85
  658.        { dup rotate
  659.          newpath 0 0 moveto (I) false charpath
  660.      dup neg rotate
  661.          pathbbox pop exch pop exch sub
  662.      dup 3 index lt { 4 -2 roll } if
  663.      pop pop
  664.        }
  665.       for pop
  666. % The underline position is halfway between the bottom of the 'A'
  667. % and the bottom of the FontBBox.
  668.       newpath 0 0 moveto (A) false charpath
  669.       FontMatrix concat
  670.       pathbbox pop pop exch pop
  671. %  Put the values in FontInfo.
  672.       3 -1 roll
  673.       restore
  674.       Font /FontBBox get 1 get add 2 div cvi
  675.       dup FontInfo /UnderlinePosition 3 -1 roll put
  676.       2 div abs FontInfo /UnderlineThickness 3 -1 roll put
  677.       FontInfo /ItalicAngle 3 -1 roll put
  678.  
  679. %  Clean up and finish.
  680.       grestore
  681.       bdfile closefile
  682.       Font currentdict end end begin        % remove font from dict stack
  683.       (\n) print flush
  684.  
  685.     } bind def
  686.  
  687. % ------ Reader for AFM files ------ %
  688.  
  689. % Dictionary for looking up character keywords
  690.    /cmdict 6 dict dup begin
  691.       /C { /c iarg def } def
  692.       /N { /n warg copystring def } def
  693.       /WX { /w narg def } def
  694.       /W0X /WX load def
  695.       /W /WX load def
  696.       /W0 /WX load def
  697.    end def
  698.  
  699.    /readAFM        % fontdict afmfilename readAFM -> fontdict
  700.     { (r) file /bdfile exch def
  701.       /Font exch def
  702.       /commentword (Comment) def
  703.  
  704. %  Check for the StartFontMetrics.
  705.       (StartFontMetrics) getline
  706.       args cvr 2.0 lt { (Not version 2.0 or greater\n) print stop } if
  707.  
  708. %  Look for StartCharMetrics, then parse the character metrics.
  709. %  The only information we care about is the X width.
  710.       /metrics 0 dict def
  711.        { nextline
  712.          keyword (EndFontMetrics) eq { exit } if
  713.      keyword (StartCharMetrics) eq
  714.       { iarg dup dict /metrics exch def
  715.          { /c -1 def /n null def /w null def
  716.            nextline buffer
  717.         { token not { exit } if
  718.           dup cmdict exch known
  719.            { exch /args exch def   cmdict exch get exec   args }
  720.            { pop }
  721.           ifelse
  722.         } loop
  723.            c 0 ge n null ne or w null ne and
  724.         { n null eq { /n Font /Encoding get c get def } if
  725.           metrics n w put
  726.         }
  727.            if
  728.          }
  729.         repeat
  730.         (EndCharMetrics) getline
  731.       } if
  732.        } loop
  733.  
  734. %  Insert the metrics in the font.
  735.        metrics length 0 ne
  736.     { Font /Metrics metrics readonly put
  737.     } if
  738.       Font
  739.     } bind def
  740.  
  741. end        % envBDF
  742.  
  743. % Enter the main program in the current dictionary.
  744. /bdfafmtops        % infilename afmfilename* outfilename fontname
  745.             %   encodingname uniqueID xuid
  746.  { envBDF begin
  747.      7 -2 roll exch 7 2 roll    % afm* in out fontname encodingname uniqueID xuid
  748.      readBDF        % afm* font
  749.      exch { readAFM } forall
  750.      save exch
  751.      dup /FontName get exch definefont
  752.      setfont
  753.      psfile writefont
  754.      restore
  755.      psfile closefile
  756.    end
  757.  } bind def
  758.  
  759. % If the program was invoked from the command line, run it now.
  760. [ shellarguments
  761.  { counttomark 4 ge
  762.     { dup 0 get
  763.       dup 48 ge exch 57 le and        % last arg starts with a digit?
  764.        { /StandardEncoding }        % no encodingname
  765.        { cvn }                % have encodingname
  766.       ifelse
  767.       exch (.) search            % next-to-last arg has . in it?
  768.        { mark 4 1 roll            % have xuid
  769.           { cvi exch pop exch (.) search not { exit } if }
  770.      loop cvi ]
  771.      3 -1 roll cvi exch
  772.        }
  773.        { cvi null            % no xuid
  774.        }
  775.       ifelse
  776.       counttomark 5 roll
  777.       counttomark 6 sub array astore
  778.       7 -2 roll cvn 7 -3 roll        % make sure fontname is a name
  779.       bdfafmtops
  780.     }
  781.     { cleartomark
  782.       (Usage:\n  bdftops xx.bdf [yy1.afm ...] zz.gsf fontname uniqueID [xuid] [encodingname]\n) print flush
  783.       mark
  784.     }
  785.    ifelse
  786.  }
  787. if pop
  788.